home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / imb9110.zip / BITLIST.BAS < prev    next >
BASIC Source File  |  1991-10-01  |  9KB  |  224 lines
  1. '****************************************************
  2. '*  BITLIST.BAS - routines to manipulate bit lists  *
  3. '****************************************************
  4.  
  5. ' $INCLUDE: 'BITLIST.BI'
  6.  
  7. CONST FALSE = 0, TRUE = NOT FALSE
  8.  
  9. CONST CPI = 2                   ' # chars in 1 integer
  10. CONST CS = 8                    ' # bits  in 1 character
  11.  
  12. FUNCTION blCreate (Size%)
  13. '****************************************************
  14. '*  blCreate - create a bitlist                     *
  15. '*                                                  *
  16. '*  INP:  Size - number of bits in the list         *
  17. '*  OUT:  'handle' of the new bitlist, NULL if      *
  18. '*        the bitlist could not be created.         *
  19. '****************************************************
  20. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  21. IF FirstFree% = 0 THEN
  22.   ' this is the first allocation, no master pointers exist yet
  23.   MasterPointers$ = STRING$(2, 0)
  24.   FirstFree% = LEN(MasterPointers$) + 1
  25.   NextList% = (FirstFree% - 1) \ 2
  26.   mPtr% = FirstFree% - 2
  27. ELSE
  28.   IF FirstFree% = LEN(MasterPointers$) + 1 THEN
  29.     ' normal allocation, no master pointers have been freed
  30.     MasterPointers$ = MasterPointers$ + STRING$(2, 0)
  31.     FirstFree% = LEN(MasterPointers$) + 1
  32.     NextList% = (FirstFree% - 1) \ 2
  33.     mPtr% = FirstFree% - 2
  34.   ELSE
  35.     ' re-use a previously freed master pointer
  36.     NextList% = (FirstFree% + 1) \ 2
  37.     mPtr% = FirstFree%
  38.     FirstFree% = ABS(CVI(MID$(MasterPointers$, mPtr%, 2)))
  39.   END IF
  40. END IF
  41. lPtr% = LEN(MAllocSpace$) + 1
  42. MAllocSpace$ = MAllocSpace$ + STRING$(((Size%+CS-1)\CS+CPI),0)
  43. MID$(MAllocSpace$, lPtr%, 2) = MKI$(Size%)
  44. MID$(MasterPointers$, mPtr%, 2) = MKI$(lPtr%)
  45. blCreate = NextList%
  46. END FUNCTION
  47.  
  48. SUB blDestroy (BitList%)
  49. '****************************************************
  50. '*  blDestroy - destroy a bitlist                   *
  51. '*                                                  *
  52. '*  INP:  BitList% - 'handle' to bitlist to destroy *
  53. '****************************************************
  54. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  55. ' de-reference the bitlist handle
  56. drBl% = CVI(MID$(MasterPointers$, BitList%*2-1, 2))
  57. ' Adjust the master pointers that come after the master pointer that
  58. ' points to the bitlist being destroyed.
  59. ' (if this was not the bitlist pointed to by the last master pointer
  60. '  in the master pointer list)
  61. IF BitList% * 2 < LEN(MasterPointers$) THEN
  62.   Adjustment% = (CVI(MID$(MAllocSpace$, drBl%, 2)) + CS - 1) \ CS + CPI
  63.   FOR aBl% = BitList% + 1 TO LEN(MasterPointers$) \ 2
  64.      mPtr% = CVI(MID$(MasterPointers$, aBl% * 2 - 1, 2))
  65.      IF mPtr% > 0 THEN
  66.        ' (pointers with values less than 1 are in the free list)
  67.        MID$(MasterPointers$, aBl% * 2 - 1, 2) = MKI$(mPtr% - Adjustment%)
  68.      END IF
  69.   NEXT aBl%
  70. END IF
  71. ' Do garbage collection on the master pointer list
  72. mPtr% = BitList% * 2 - 1
  73. MID$(MasterPointers$, mPtr%, 2) = MKI$(0)
  74. IF mPtr% + 1 = LEN(MasterPointers$) THEN
  75.   ' this is the master pointer at the end of the list,
  76.   ' so just get rid of it. We'll allocate it again if we need to.
  77.   MasterPointers$ = LEFT$(MasterPointers$, mPtr% - 1)
  78. ELSE
  79.   IF FirstFree% > LEN(MasterPointers$) THEN
  80.     ' this is the first master pointer we've freed
  81.     FirstFree% = mPtr%
  82.   ELSE
  83.     ' add this master pointer to the free list
  84.     Prev% = 0: Done% = FALSE: WorkPtr% = FirstFree%
  85.     DO UNTIL Done%
  86.       ' look for the end of the list
  87.       NextPtr% = ABS(CVI(MID$(MasterPointers$, WorkPtr%, 2)))
  88.       IF NextPtr% = 0 THEN
  89.         ' we've found the end of the free list
  90.         ' set this node to pint to the master pointer we just freed
  91.         MID$(MasterPointers$, WorkPtr%, 2) = MKI$(-mPtr%)
  92.         Done% = TRUE
  93.       ELSE
  94.         ' follow the link
  95.         WorkPtr% = NextPtr%
  96.       END IF
  97.     LOOP
  98.   END IF
  99. END IF
  100. ' reclaim the space used by the list being destroyed
  101. listLen% = CVI(MID$(MAllocSpace$, drBl%, 2))
  102. SubStrLen% = (listLen% + CS - 1) \ CS + CPI
  103. Front$ = LEFT$(MAllocSpace$, drBl% - 1)
  104. RearStart% = drBl% + SubStrLen%
  105. Rear$ = MID$(MAllocSpace$, RearStart%, LEN(MAllocSpace$) - RearStart% + 1)
  106. MAllocSpace$ = Front$ + Rear$: Front$ = "": Rear$ = ""
  107. END SUB
  108.  
  109. FUNCTION blGetBit (bl%, BitNum%)
  110. '****************************************************
  111. '*  blGetBit - return current bit state             *
  112. '*                                                  *
  113. '*  INP:  bl% - 'handle' to bitlist of interest     *
  114. '*        BitNum% - the bit number of interest      *
  115. '*  OUT:  FALSE is bit is off or out of range,      *
  116. '*        TRUE otherwise.                           *
  117. '****************************************************
  118. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  119. ' de-reference the bitlist handle
  120. drBl% = CVI(MID$(MasterPointers$, bl%*2-1, 2))
  121. IF BitNum% >= CVI(MID$(MAllocSpace$, drBl%, 2)) THEN
  122.   fRes% = FALSE
  123. ELSE
  124.   ByteNum% = BitNum% \ 8 + CPI
  125.   BitNum% = BitNum% MOD 8
  126.   fRes% = ASC(MID$(MAllocSpace$, drBl%+ByteNum%, 1)) AND 2 ^ BitNum%
  127. END IF
  128. blGetBit = fRes%
  129. END FUNCTION
  130.  
  131. FUNCTION blSetBit (bl%, BitNum%, State%)
  132. '****************************************************
  133. '*  blSetBit - return current bit state             *
  134. '*                                                  *
  135. '*  INP:  bl% - 'handle' to bitlist of interest     *
  136. '*        BitNum% - the bit number of interest      *
  137. '*        State% - the new bit state                *
  138. '*  OUT:  TRUE on error, FALSE otherwise            *
  139. '****************************************************
  140. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  141. ' de-reference the bitlist handle
  142. drBl% = CVI(MID$(MasterPointers$, bl%*2-1, 2))
  143. IF BitNum% >= CVI(MID$(MAllocSpace$, drBl%, 2)) THEN
  144.   fRes% = TRUE
  145. ELSE
  146.   ByteNum% = BitNum% \ 8 + CPI
  147.   BitNum% = BitNum% MOD 8
  148.   Mask% = 2 ^ BitNum%
  149.   IF State% THEN
  150.     MID$(MAllocSpace$, drBl%+ByteNum%, 1) = _
  151.          CHR$(ASC(MID$(MAllocSpace$, drBl%+ByteNum%, 1)) OR Mask%)
  152.   ELSE
  153.     MID$(MAllocSpace$, drBl%+ByteNum%, 1) = _
  154.          CHR$(ASC(MID$(MAllocSpace$, drBl%+ByteNum%, 1)) _
  155.          AND ((NOT Mask%) AND &HFF))
  156.   END IF
  157.   fRes% = FALSE
  158. END IF
  159. blSetBit = fRes%
  160. END FUNCTION
  161.  
  162. FUNCTION blListOp (Op%, bl1%, bl2%)
  163. '****************************************************
  164. '*  blListOp - perform a list operation             *
  165. '*                                                  *
  166. '*  INP:  Op% - operation code to perform:          *
  167. '*             blUNION, blINTERSECT,  blCLEAR       *
  168. '*             blCOPY, blSET,         blINVERT      *
  169. '*        bl1% - bitlist #1                         *
  170. '*        bl2% - bitlist #2 (or 0 if no 2nd bitlist *
  171. '*              as for blCLEAR, blSET & blINVERT    *
  172. '*                                                  *
  173. '*  OUT:  TRUE if UNION or INTERSECT or COPY detect *
  174. '*             that the lists are different sizes,  *
  175. '*        FALSE otherwise.                          *
  176. '****************************************************
  177. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  178. ' de-reference the bitlist handles
  179. drBl1% = CVI(MID$(MasterPointers$, bl1%*2-1, 2))
  180. IF bl2% <> 0 THEN
  181.   drBl2% = CVI(MID$(MasterPointers$, bl2%*2-1, 2))
  182. END IF
  183. IF Op% = blUNION OR Op% = blINTERSECT OR Op% = blCOPY THEN
  184.   IF CVI(MID$(MAllocSpace$, drBl1%, 2)) <> CVI(MID$(MAllocSpace$, drBl2%, 2)) _
  185.    THEN
  186.     fRes% = TRUE
  187.     EXIT FUNCTION
  188.   END IF
  189. END IF
  190.  
  191. drBl1Len% = (CVI(MID$(MAllocSpace$, drBl1%, 2)) + CS-1)\CS
  192. fRes% = FALSE
  193. SELECT CASE Op%
  194.       CASE blCLEAR
  195.           MID$(MAllocSpace$, drBl1%+CPI, drBl1Len%) = STRING$(drBl1Len%, 0)
  196.       CASE blSET
  197.           MID$(MAllocSpace$, drBl1%+CPI, drBl1Len%) = STRING$(drBl1Len%, 255)
  198.       CASE blINVERT
  199.           FOR I%=CPI TO drBl1Len%+CPI-1
  200.              MID$(MAllocSpace$, drBl1%+I%, 1) = _
  201.                CHR$((NOT ASC(MID$(MAllocSpace$, drBl1%+I%, 1)) AND &HFF))
  202.           NEXT I%
  203.       CASE blUNION
  204.           FOR I%=CPI TO drBl1Len%+CPI-1
  205.              MID$(MAllocSpace$, drBl1%+I%, 1) = _
  206.                CHR$(ASC(MID$(MAllocSpace$, drBl1%+I%, 1)) _
  207.                  OR ASC(MID$(MAllocSpace$, drBl2%+I%, 1)))
  208.           NEXT I%
  209.       CASE blINTERSECT
  210.           FOR I%=CPI TO drBl1Len%+CPI-1
  211.              MID$(MAllocSpace$, drBl1%+I%, 1) = _
  212.                CHR$(ASC(MID$(MAllocSpace$, drBl1%+I%, 1)) _
  213.                 AND ASC(MID$(MAllocSpace$, drBl2%+I%, 1)))
  214.           NEXT I%
  215.       CASE blCOPY
  216.           MID$(MAllocSpace$, drBl1%+CPI, drBl1Len%) = _
  217.            MID$(MAllocSpace$, drBl2%+CPI, drBl1Len%)
  218.       CASE ELSE
  219.           fRes% = TRUE
  220. END SELECT
  221. blListOp = fRes%
  222. END FUNCTION
  223.  
  224.